home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / C_MNU.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  7.2 KB  |  224 lines

  1. //*****************************************************************************
  2. // C_Mnu.prg
  3. // Simple menu class for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "InKey.ch"
  9. #include "SetCurs.ch"
  10. #include "Object.ch"
  11.  
  12. create class Mnu from Win
  13.   export:
  14.   var Help       // {}                  //{Idx,...}
  15.   var Items      // {}                  //{"item1",...}
  16.   var SelItems   // {}                  //{lSelectable,...}
  17.   var Cursor     // (object of Cursor)
  18.   var Choice     // 1                   //user selected
  19.   var Top        // 1                   //top item in menu
  20.   var CanAppend  // false               //append/delete command allowed
  21.   var InsBlock   // {|o|nil}            //database insert_row_code_block
  22.   var DelBlock   // {|o|nil}            //database delete_row_code_block
  23.   method New=MnuNew                         //o:New()
  24.   method Init=MnuInit                        //o:Init(Name,R,C,CurSize,Items,SelItems,Clr,Shadow)
  25.   method Process=MnuProcess                  //o:Process(),;
  26.   method Done=MnuDone                        //o:Done()
  27.   endclass
  28.  
  29.  
  30. //*****************************************************************************
  31. // Mnu:New() --> self
  32. // initialize new object
  33. //
  34. constructor MnuNew()
  35.   ::Help:= {}
  36.   ::Items:= {}
  37.   ::SelItems:= {}
  38.   ::Cursor:= (object of Cursor)
  39.   ::Choice:= 1
  40.   ::Top:= 1
  41.   ::CanAppend:= false
  42.   ::InsBlock:= {|o|nil}
  43.   ::DelBlock:= {|o|nil}
  44.   return(self)
  45.  
  46.  
  47. //*****************************************************************************
  48. // Mnu:Init(Name,R,C,CurSize,Items,SelItems,Clr,Shadow) --> true
  49. // initialize new simple menu.
  50. //
  51. method function MnuInit(Name,R,C,CurSize,Items,SelItems,Clr,Shadow)
  52.   local Rs,Cs
  53.   local C2,aClr
  54.   default Clr to m->Color:Menu
  55.   Rs:=Min(Len(Items),MaxRow()-7)
  56.   Cs:=Min(aWidth(Items,{|e|Len(e)-if(At("~",e)>0,1,0)}),MaxCol()-9)
  57.   if Empty(SelItems)
  58.     SelItems:=Array(Len(Items))
  59.     AFill(SelItems,true)
  60.   endif
  61.   if Empty(::Help)
  62.     ::Help:=Array(Len(Items))
  63.     AFill(::Help,0)
  64.   endif
  65.   ::Cursor:Get()
  66.   ::super(Win):GoodInit(Name,R,C,Rs,Cs,CurSize,Clr,Shadow)
  67.   ::Items:=Items
  68.   ::SelItems:=SelItems
  69.   *
  70.   R:=::Row+1
  71.   C:=::Col+1
  72.   C2:=::Col+::ColSize
  73.   aClr:=ListAsArray(::Color)
  74.   AAdd(aClr,if(m->tColor==1,GetBack(aClr[nNormal]),GetFore(aClr[nNormal]))+"/"+GetBack(aClr[nEnhanced]))
  75.   DispBegin()
  76.   ::super(Win):Paint(true,false)
  77.   IEval(Rs,{|i|DrawItem(R++,C,C2,Cs,Items[i],SelItems[i],false,aClr)})
  78.   if ::Choice>0
  79.     R:=::Row+::Choice
  80.     DrawItem(R,C,C2,Cs,Items[::Choice],SelItems[::Choice],true,aClr)
  81.   endif
  82.   DispEnd()
  83.   return(true)
  84.  
  85.  
  86. //*****************************************************************************
  87. // Mnu:Process() --> nChoice
  88. // allow user select one from menu items.
  89. //
  90. method function MnuProcess()
  91.   local R,C,Rs,Cs,R2,C2,Items,SelItems,aClr
  92.   local OldRow,Row,Ch,i,Key,Msg
  93.   SetCursor(SC_NONE)
  94.   Msg:=SetDMsg()
  95.   PreProcess(self,Msg,@R,@C,@Rs,@Cs,@R2,@C2,@Items,@SelItems,@aClr,@OldRow,@Row,@i)
  96.   SaveHelpIdx({16})
  97.   repeat
  98.     TrueIdx(@Row,0,R,R2,SelItems)
  99.     if OldRow<>Row
  100.       DispBegin()
  101.       DrawItem(OldRow,C,C2,Cs,Items[OldRow-R+1],SelItems[OldRow-R+1],false,aClr)
  102.       DrawItem(Row,C,C2,Cs,Items[Row-R+1],SelItems[Row-R+1],true,aClr)
  103.       DispEnd()
  104.     endif
  105.     OldRow:=Row
  106.     i:=Row-R+1
  107.     ReadHelpVar("MENU->"+NTrim(::Help[i]))
  108.     Key:=PauseKey(0)
  109.     ReadHelpVar("")
  110.     if Key==K_ESC; i:=-Abs(i); endif
  111.     if !SelItems[Abs(i)]; i:=-Abs(i); endif
  112.     ::Choice:=i
  113.     do case
  114.       case Key==K_UP;       TrueIdx(@Row,-1,R,R2,SelItems)
  115.       case Key==K_DOWN;     TrueIdx(@Row,+1,R,R2,SelItems)
  116.       case Key==K_HOME;     Row:=R
  117.       case Key==K_END;      Row:=R2
  118.       case Key==K_INS;      if ::CanAppend; Eval(::InsBlock, self); PreProcess(self,Msg,@R,@C,@Rs,@Cs,@R2,@C2,@Items,@SelItems,@aClr,@OldRow,@Row,@i); endif
  119.       case Key==K_DEL;      if ::CanAppend; Eval(::DelBlock, self); PreProcess(self,Msg,@R,@C,@Rs,@Cs,@R2,@C2,@Items,@SelItems,@aClr,@OldRow,@Row,@i); endif
  120.       case Key==nSwapTask;  Key:=K_ESC    //exit from menu
  121.       case Key==K_CTRL_RET; Key:=K_ENTER  //select item
  122.       case Key==K_ESC       //dummy
  123.       case Key==K_ENTER     //dummy
  124.       otherwise
  125.         Ch:=Upper(Chr(Key))
  126.         if ("0"<=Ch and Ch<="9") or ("A"<=Ch and Ch<="Z")
  127.           Ch:="~"+Ch
  128.           if (i:=AScan(Items,{|e| At(Ch,Upper(e))>0}))>0
  129.             Row:=R+i-1
  130.             StuffKey(K_ENTER)
  131.           endif
  132.         else
  133.           Key:=K_ESC
  134.         endif
  135.     endcase
  136.   until Key==K_ENTER or Key==K_ESC or Empty(Items)
  137.   RestHelpIdx()
  138.   if Key==K_ESC; ::Choice:=-Abs(::Choice); endif
  139.   if Empty(Items); ::Choice:=0; SetLastKey(0); endif
  140.   DOut(Msg)
  141.   return(::Choice)
  142.  
  143.  
  144. //-----------------------------------------------------------------------------
  145. // Mnu::PreProcess(...) -->nil
  146. // (re)initialize local variables for Mnu:Process()
  147. //
  148. static function PreProcess(Mnu,Msg,R,C,Rs,Cs,R2,C2,Items,SelItems,aClr,OldRow,Row,i)
  149.   DOut(Msg+if(Mnu:CanAppend,","+ResTxt(143),""))
  150.   R:=Mnu:Row+1
  151.   C:=Mnu:Col+1
  152.   Rs:=Mnu:RowSize
  153.   Cs:=Mnu:ColSize
  154.   R2:=Mnu:Row+Mnu:RowSize
  155.   C2:=Mnu:Col+Mnu:ColSize
  156.   Items:=Mnu:Items
  157.   SelItems:=Mnu:SelItems
  158.   aClr:=ListAsArray(Mnu:Color)
  159.   AAdd(aClr,if(m->tColor==1,GetBack(aClr[nNormal]),GetFore(aClr[nNormal]))+"/"+GetBack(aClr[nEnhanced]))
  160.   i:=Mnu:Choice
  161.   OldRow:=Row:=R+Abs(i)-1
  162.   if i<0
  163.     i:=-i
  164.     DrawItem(Row,C,C2,Cs,Items[i],SelItems[i],true,aClr)
  165.   endif
  166.   return(nil)
  167.  
  168.  
  169. //-----------------------------------------------------------------------------
  170. // TrueIdx(@Idx,nDirection,R,R2,SelItems) --> true
  171. // evaluate true Idx for pop menu, check availability of the item
  172. //
  173. static function TrueIdx(Idx,nDirection,R,R2,SelItems)
  174.   local i:=Len(SelItems)+1
  175.   if AScan(SelItems,true)==0; return(true); endif
  176.   if nDirection==0; Idx--; nDirection++; endif
  177.   repeat
  178.     i--
  179.     Idx+=nDirection
  180.     if Idx<R and Set(_SET_WRAP); Idx:=R2
  181.     elseif Idx>R2 and Set(_SET_WRAP); Idx:=R
  182.     elseif Idx<R; Idx:=R; if !SelItems[1]; nDirection:=+1; endif
  183.     elseif Idx>R2; Idx:=R2; if !ATail(SelItems); nDirection:=-1; endif
  184.     endif
  185.   until SelItems[Idx-R+1] or i==0
  186.   return(true)
  187.  
  188.  
  189. //-----------------------------------------------------------------------------
  190. // DrawItem(R,C,C2,S,It,SelIt,HiIt,Clr) --> true
  191. // draw one menu item for OChoice
  192. //
  193. static function DrawItem(R,C,C2,S,It,SelIt,HiIt,Clr)
  194.   local cn,cl,i:=At("~",It)
  195.   if m->tColor<>0
  196.     cn:=Clr[if(SelIt,if(HiIt,nExtension,nNormal),nDisable)]
  197.     cl:=Clr[if(SelIt,if(HiIt,nSelected,nLetter),nDisable)]
  198.   else
  199.     cn:=Clr[if(SelIt,if(HiIt,nSelected,nNormal),nDisable)]
  200.     cl:=Clr[if(SelIt,nLetter,nDisable)]
  201.   endif
  202.   SetPos(R,C)
  203.   if i>0
  204.     DispOut(Left(It,i-1),cn)
  205.     DispOut(SubStr(It,i+1,1),cl)
  206.     DispOut(PadR(SubStr(It,i+2),C2-C-i+1),cn)
  207.   else
  208.     DispOut(PadR(It,C2-C+1),cn)
  209.   endif
  210.   return(true)
  211.  
  212.  
  213. //*****************************************************************************
  214. // Mnu:Done() --> true
  215. // destroy the simple menu.
  216. //
  217. method function MnuDone()
  218.   ::Hide()
  219.   ::Cursor:Set()
  220.   return(true)
  221.  
  222. //------------------------------------------------------- eof (c)JHK ----------
  223.  
  224.